home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 27.zip / BS1 part 27 / VisionaleV1.1-D1.adf / virx / HorizontalWave.virx < prev    next >
Text File  |  1992-10-30  |  2KB  |  93 lines
  1. /*
  2.  * HorizontalWave.virx
  3.  * Copyright (c)1992 Bruno Costa & Lucia Darsa
  4.  */
  5.  
  6. options results
  7.  
  8. signal on HALT
  9. signal on SYNTAX
  10. signal on FAILURE
  11.  
  12. call openmath
  13.  
  14. lockgui
  15.  
  16. form = '"BOOL,_TO Window,0|'        ||,
  17.        'BOOL,Just _Selected Vertices,0|'||,
  18.        'STR,_Amplitude:,5.0,6|'        ||,
  19.        'STR,Number of _Waves:,3,6"'
  20.  
  21. requestform TITLE '"Horizontal Wave"' form
  22. if rc >= 5 then
  23.   signal HALT
  24.  
  25. parse var result window '|' selected '|' amplitude '|' nwaves
  26.  
  27. if window = 0 then
  28.   winname = 'FROM'
  29. else
  30.   winname = 'TO'
  31.  
  32. getdensity
  33. parse var result nrows ncols
  34.  
  35. if selected = 1 then
  36.   getmesh winname 'SELECTED'
  37. else
  38.   getmesh winname
  39.  
  40. parse var result width height inmesh
  41.  
  42.  
  43. pi = 3.14159
  44. k = (2 * pi) / (height / nwaves)
  45.  
  46. outmesh = ''
  47. sel = 1
  48. do row = 1 to nrows
  49.   do col = 1 to ncols
  50.     if selected = 1 then
  51.       parse var inmesh inx iny sel inmesh
  52.     else
  53.       parse var inmesh inx iny inmesh
  54.  
  55.     outy = iny
  56.     if sel  &  col > 1  &  col < ncols then
  57.       outx = inx + amplitude * sin(k * iny)
  58.     else
  59.       outx = inx
  60.     outmesh = outmesh outx outy
  61.   end
  62. end
  63.  
  64. setmesh winname '"'outmesh'"'
  65.  
  66. unlockgui
  67. exit 0
  68.  
  69. /* add rexxmathlib.library if it is not already open */
  70. openmath: procedure
  71.  if ~show('L', "rexxmathlib.library") then do
  72.    if ~addlib("rexxmathlib.library", 0, -30, 0) then do
  73.      requestnotify "could not open rexxmathlib.library"
  74.      exit 20
  75.    end
  76.  end
  77.  return
  78.  
  79. BREAK_C:
  80. HALT:
  81.  unlockgui
  82.  exit 20
  83.  
  84. FAILURE:
  85.  requestnotify '"Host *"'address()'*" returned an error (severity 'rc')*nexecuting' compress(sourceline(2),'* ') 'at line' SIGL'"'
  86.  unlockgui
  87.  exit 20
  88.  
  89. SYNTAX:
  90.  requestnotify '"'errortext(rc)'*nexecuting' compress(sourceline(2),'* ') 'at line' SIGL'"'
  91.  unlockgui
  92.  exit 20
  93.